home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / pcl4p33.zip / TERM.PAS < prev    next >
Pascal/Delphi Source File  |  1992-05-30  |  10KB  |  292 lines
  1. (*********************************************)
  2. (*                                           *)
  3. (*      TERM.PAS          May 1992           *)
  4. (*                                           *)
  5. (*  TERM is a simple terminal emulator which *)
  6. (*  features XMODEM, YMODEM, and YMODEM-G    *)
  7. (*  file transfer                            *)
  8. (*                                           *)
  9. (*  Do NOT select YMODEM-G when using a null *)
  10. (*  modem cable unless you are certain that  *)
  11. (*  RTS & CTS are reversed -- which is       *)
  12. (*  usually not true.                         *)
  13. (*                                           *)
  14. (*  This program is donated to the Public    *)
  15. (*  Domain by MarshallSoft Computing, Inc.   *)
  16. (*  It is provided as an example of the use  *)
  17. (*  of the Personal Communications Library.  *)
  18. (*                                           *)
  19. (*********************************************)
  20.  
  21. {$I DEFINES.PAS}
  22.  
  23. program term;
  24. uses term_io, modem_io, xymodem, xypacket, crc, crt, PCL4P;
  25.  
  26. Var
  27.   ResetFlag : Boolean;
  28.   Port : Integer;
  29.   SioBuffer : array[0..2047] of Byte;
  30.  
  31. function MatchBaud(BaudRate : LongInt) : Integer;
  32. Label 999;
  33. const
  34.    BaudRateArray : array[1..10] of LongInt =
  35.        (300,600,1200,2400,4800,9600,19200,38400,57600,115200);
  36. var
  37.    i : Integer;
  38. begin
  39.    for i := 1 to 10 do if BaudRateArray[i] = BaudRate then
  40.       begin
  41.         MatchBaud := i - 1;
  42.         goto 999
  43.       end;
  44.    (* no match *)
  45.    MatchBaud := -1;
  46. 999: end;
  47.  
  48. procedure MyHalt( Code : Integer );
  49. var
  50.    RetCode : Integer;
  51. begin
  52.    if Code < 0 then SayError( Code,'Halting' );
  53.    if ResetFlag then RetCode := SioDone(Port);
  54.    writeln('*** HALTING ***');
  55.    Halt;
  56. end;
  57.  
  58. (* main program *)
  59.  
  60. label 500;
  61.  
  62. const
  63.   NAK = $15;
  64.   WrongBaud1 = 'Cannot recognize baud rate';
  65.   WrongBaud2 = 'Must be 300,600,1200,2400,4800,9600,19200,38400,57600, or 155200';
  66.  
  67. var
  68.   Filename : String20;
  69.   c : Char;
  70.   BaudRate : LongInt;
  71.   BaudCode : Integer;
  72.   Protocol : Char;
  73.   Buffer  : BufferType;
  74.   RetCode : Integer;
  75.   TheByte : Char;
  76.   i       : Integer;
  77.   MenuMsg : String40;
  78.   StatusMsg : String40;
  79.   ResultMsg : String20;
  80.   GetNameMsg: String40;
  81.   OneKflag : Boolean;
  82.   NCGbyte  : Byte;
  83.   BatchFlag: Boolean;
  84.   Flag : Boolean;
  85.   Version : Integer;
  86. begin   (* main program *)
  87.   InitCRC;
  88.   TextMode(BW80);
  89.   ClrScr;
  90.   Window(1,1,80,24);
  91.   ResetFlag := FALSE;
  92.   Protocol := 'X';
  93.   OneKflag := FALSE;
  94.   NCGbyte := NAK;
  95.   BatchFlag := FALSE;
  96.   MenuMsg := 'Q)uit P)rotocol S)end R)eceive: ';
  97.   GetNameMsg := 'Enter filename: ';
  98.   StatusMsg := 'COM? X  "ESC for menu" ';
  99.   (* fetch PORT # from command line *)
  100.   if ParamCount <> 2 then
  101.     begin
  102.       writeln('USAGE: "TERM <port> <buadrate>" ');
  103.       halt;
  104.     end;
  105.   Val( ParamStr(1),Port, RetCode );
  106.   if RetCode <> 0 then
  107.     begin
  108.       writeln('Port must be 1 to 4');
  109.       Halt;
  110.     end;
  111.   (* COM1 = 0, COM2 = 1, COM3 = 2, COM4 = 3 *)
  112.   Port := Port - 1;
  113.   Val( ParamStr(2),BaudRate, RetCode );
  114.   if RetCode <> 0 then
  115.     begin
  116.       writeln(WrongBaud1);
  117.       writeln(WrongBaud2);
  118.       Halt;
  119.     end;
  120.   BaudCode := MatchBaud(BaudRate);
  121.   if BaudCode < 0 then
  122.     begin
  123.       writeln(WrongBaud1);
  124.       writeln(WrongBaud2);
  125.       halt;
  126.     end;
  127.   (* patch up status message *)
  128.   StatusMsg[4] := chr($31+Port);
  129.   Insert(ParamStr(2),StatusMsg,8);
  130.   WriteMsg(StatusMsg,40);
  131.   if (Port<COM1) or (Port>COM4) then
  132.     begin
  133.       writeln('Port must be 1 to 4');
  134.       Halt
  135.     end;
  136.   (* setup 2K receive buffer *)
  137.   RetCode := SioRxBuf(Port, Ofs(SioBuffer), Seg(SioBuffer), Size2K);
  138.   if RetCode < 0 then MyHalt( RetCode );
  139.   (* reset port *)
  140.   RetCode := SioReset(Port,BaudCode);
  141.   (* if error then try one more time *)
  142.   if RetCode <> 0 then RetCode := SioReset(Port,BaudCode);
  143.   (* Was port reset ? *)
  144.   if RetCode <> 0 then
  145.     begin
  146.       writeln('Cannot reset COM',Port+1);
  147.       MyHalt( RetCode );
  148.     end;
  149.   (* Port successfully reset *)
  150.   ResetFlag := TRUE;
  151.   ClrScr;
  152.   (* show logon message *)
  153.   WriteLn('TERM 5/1/92');
  154.   Version := SioInfo('V');
  155.   WriteLn('Library Version ',Version div 16,'.',Version mod 16);
  156.   (* specify parity, # stop bits, and word length for port *)
  157.   RetCode := SioParms(Port, NoParity, OneStopBit, WordLength8);
  158.   if RetCode < 0 then MyHalt( RetCode );
  159.   RetCode := SioRxFlush(Port);
  160.   if RetCode < 0 then MyHalt( RetCode );
  161.   (* set FIFO level if have INS16550 *)
  162.   RetCode := SioFIFO(Port, LEVEL_8);
  163.   if RetCode > 0 then writeln('INS16550 detected');
  164.   (* set DTR & RTS *)
  165.   RetCode := SioDTR(Port,SetPort);
  166.   RetCode := SioRTS(Port,SetPort);
  167. {$IFDEF RTS_CTS_CONTROL}
  168.   (* enable RTS/CTS flow control *)
  169.   RetCode := SioFlow(Port,3*18);
  170.   WriteLn('Hardware flow control enabled');
  171.   Write('CTS = ');
  172.   if SioCTS(Port) > 0 then WriteLn('ON') else WriteLn('OFF');
  173. {$ENDIF}
  174.  
  175. {$IFDEF AT_COMMAND_SET}
  176.   (* send initialization string to modem *)
  177.   SendTo(Port,'!AT!!~');
  178.   SendTo(Port,'!AT E1 S7=60 S11=60 V1 X1 Q0 S0=1!');
  179.   if WaitFor(Port,'OK') then writeln('MODEM ready')
  180.   else writeln('WARNING: Expected OK not received');
  181. {$ENDIF}
  182.  
  183.   (* begin terminal loop *)
  184.   WriteMsg(StatusMsg,40);
  185.   LowVideo;
  186.   while TRUE do
  187.     begin (* while TRUE *)
  188.       (* did user press Ctrl-BREAK ? *)
  189.       if SioBrkKey then
  190.         begin
  191.           writeln('User typed Ctl-BREAK');
  192.           RetCode := SioDone(Port);
  193.           Halt;
  194.         end;
  195.       (* anything incoming over serial port ? *)
  196.       RetCode := SioGetc(Port,0);
  197.       if RetCode < -1 then MyHalt( RetCode );
  198.       if RetCode > -1 then write(chr(RetCode));
  199.       (* has user pressed keyboard ? *)
  200.       if KeyPressed then
  201.         begin (* keypressed *)
  202.           (* read keyboard *)
  203.           TheByte := ReadKey;
  204.           (* quit if user types ESC *)
  205.           if TheByte = chr($1b) then
  206.             begin (* ESC *)
  207.               WriteMsg(MenuMsg,1);
  208.               ReadMsg(ResultMsg,32,1);
  209.               c := UpCase(ResultMsg[1]);
  210.               case c of
  211.                 'Q':  (* QUIT *)
  212.                    begin
  213.                      WriteLn;
  214.                      WriteLn('TERMINATING: User pressed <ESC>');
  215.                      RetCode := SioDone(Port);
  216.                      Halt;
  217.                    end;
  218.                 'P':  (* PROTOCOL *)
  219.                    begin
  220.                      WriteMsg('X) xmodem, Y) ymodem, G) ymodem-g:  ',1);
  221.                      ReadMsg(ResultMsg,35,1);
  222.                      c := UpCase(ResultMsg[1]);
  223.                      case c of
  224.                        'X': (* XMODEM *)
  225.                           begin
  226.                             Protocol := 'X';
  227.                             OneKflag := FALSE;
  228.                             NCGbyte := NAK;
  229.                             BatchFlag := FALSE;
  230.                             WriteMsg('Protocol = XMODEM',1);
  231.                           end;
  232.                        'Y': (* YMODEM *)
  233.                           begin
  234.                             Protocol := 'Y';
  235.                             OneKflag := TRUE;
  236.                             NCGbyte := Ord('C');
  237.                             BatchFlag := TRUE;
  238.                             WriteMsg('Protocol = YMODEM',1);
  239.                           end;
  240.                        'G': (* YMODEM-G *)
  241.                           begin
  242.                             Protocol := 'G';
  243.                             OneKflag := TRUE;
  244.                             NCGbyte := Ord('G');
  245.                             BatchFlag := TRUE;
  246.                             WriteMsg('Protocol = YMODEM-G',1);
  247.                           end;
  248.                      end; (* case *)
  249.                      StatusMsg[6] := Protocol;
  250.                      WriteMsg(StatusMsg,40)
  251.                    end;
  252.                 'S': (* Send *)
  253.                    begin
  254.                      WriteMsg(GetNameMsg,1);
  255.                      ReadMsg(Filename,16,20);
  256.                      if Length(FileName) = 0 then goto 500;
  257.                      Flag := TxyModem(Port,Filename,Buffer,OneKflag,BatchFlag);
  258.                      if BatchFlag then
  259.                        begin
  260.                          (* send empty filename *)
  261.                          Filename := '';
  262.                          RetCode := SioDelay(5);
  263.                          Flag := TxyModem(Port,Filename,Buffer,OneKflag,BatchFlag);
  264.                        end
  265.                      end; (* Send *)
  266.                   'R': (* Receive *)
  267.                      begin
  268.                        if BatchFlag then
  269.                          repeat
  270.                            WriteMsg('Ready for next file',1);
  271.                            Filename := '';
  272.                            Flag := RxyModem(Port,Filename,Buffer,NCGbyte,BatchFlag);
  273.                          until KeyPressed or (Length(Filename) = 0)
  274.                        else
  275.                          begin (* not BatchFlag *)
  276.                            WriteMsg(GetNameMsg,1);
  277.                            ReadMsg(Filename,16,20);
  278.                            If Length(Filename) = 0 then exit;
  279.                            Flag := RxyModem(Port,Filename,Buffer,NCGbyte,BatchFlag);
  280.                          end
  281.                      end (* Receive *)
  282.                    else WriteMsg('Bad response',1);
  283.                    end; (* case *)
  284.                    500:
  285.                 end; (* ESC *)
  286.               (* send out over serial line *)
  287.               RetCode := SioPutc(Port, TheByte );
  288.               if RetCode < 0 then MyHalt( RetCode );
  289.             end (* keypressed *)
  290.       end (* while TRUE *)
  291. end.
  292.